perm filename READER.NR[LSP,JRA] blob
sn#185985 filedate 1975-11-13 generic text, type T, neo UTF8
(DE INIT()(SETQ Z(SETQ CP NIL]
(DEFPROP READ*
(LAMBDA NIL
(PROG NIL
(SETQ J (RATOM*))
(COND ((OR (IS_RPAR J) (IS_DOT J)) (ERR (PRINT (QUOTE FOO1))))
((IS_LPAR J) (SETQ Z (CONS NIL 1)) (RPLACA Z (CONS NIL Z)) (SETQ CP (CAR Z)) (GO HEAD))
((ATOM J) (RETURN J)))
HEAD (SETQ J (RATOM*))
(COND ((OR (IS_DOT J) (IS_RPAR J)) (ERR (PRINT (QUOTE FOO3))))
((IS_LPAR J) (RPLACD Z (ADD1 (CDR Z))) (RPLACA CP (CONS NIL CP)) (SETQ CP (CAR CP)) (GO HEAD))
((ATOM J) (RPLACA CP J) (GO TAIL)))
TAIL (SETQ J (RATOM*))
(COND ((IS_RPAR J) (RPLACD Z (SUB1 (CDR Z)))
(COND ((EQ Z CP) (GO CHECKEND1))
(T (SETQ TEMP (CDR CP)) (RPLACD CP NIL) (SETQ CP TEMP) (GO CHECKEND))))
((IS_LPAR J) (RPLACD Z (ADD1 (CDR Z)))
(RPLACD CP (CONS NIL (CDR CP)))
(SETQ CP (CDR CP))
(RPLACA CP(CONS NIL CP))
(SETQ CP (CAR CP))
(GO HEAD))
((IS_DOT J) (GO DOT))
((ATOM J) (RPLACD CP (CONS J (CDR CP))) (SETQ CP (CDR CP)) (GO CHECKEND)))
DOT (SETQ J (RATOM*))
(COND ((OR (IS_DOT J) (IS_RPAR J)) (ERR (PRINT (QUOTE FOO4))))
((IS_LPAR J) (RPLACD Z (ADD1 (CDR Z)))
(RPLACD CP (CONS NIL (CDR CP)))
(SETQ CP (CDR CP))
(GO HEAD))
((ATOM J) (SETQ TEMP (CDR CP))
(RPLACD CP J)
(SETQ CP TEMP)
(GO CHECKEND)))
CHECKEND
(COND ((EQ Z CP) (GO CHECKEND1)) (T (GO TAIL)))
CHECKEND1
(SETQ TEMP (CDR CP))
END2 (COND ((ZEROP TEMP) (RETURN (CAR CP))))
(SETQ J (RATOM*))
(COND ((IS_RPAR J) (SETQ TEMP (SUB1 TEMP)) (GO END2)) (T (ERR (PRINT (QUOTE FOO5)))))))
EXPR)
(DEFPROP RATOM*
(LAMBDA NIL (READ))
EXPR)
(DEFPROP IS_RPAR
(LAMBDA (J) (EQ J (QUOTE /))))
EXPR)
(DEFPROP IS_LPAR
(LAMBDA (J) (EQ J (QUOTE /()))
EXPR)
(DEFPROP IS_DOT
(LAMBDA (J) (EQ J (QUOTE /.)))
EXPR)